home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / MyHelp2124908272008.psc / KB Builder / frmAddDate.frm < prev    next >
Text File  |  2008-08-27  |  4KB  |  141 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAddDate 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Insert Date/Time"
  5.    ClientHeight    =   2805
  6.    ClientLeft      =   45
  7.    ClientTop       =   435
  8.    ClientWidth     =   3975
  9.    ControlBox      =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   2805
  23.    ScaleWidth      =   3975
  24.    StartUpPosition =   1  'CenterOwner
  25.    Begin VB.CommandButton cmdDone 
  26.       Caption         =   "Done"
  27.       Height          =   375
  28.       Left            =   2520
  29.       TabIndex        =   3
  30.       Top             =   2280
  31.       Width           =   1335
  32.    End
  33.    Begin VB.CommandButton cmdOk 
  34.       Caption         =   "Apply"
  35.       Height          =   375
  36.       Left            =   2520
  37.       TabIndex        =   2
  38.       Top             =   1800
  39.       Width           =   1335
  40.    End
  41.    Begin VB.ListBox List1 
  42.       Height          =   2205
  43.       ItemData        =   "frmAddDate.frx":0000
  44.       Left            =   120
  45.       List            =   "frmAddDate.frx":0022
  46.       Sorted          =   -1  'True
  47.       TabIndex        =   0
  48.       Top             =   480
  49.       Width           =   2295
  50.    End
  51.    Begin VB.Line Line1 
  52.       BorderColor     =   &H00808080&
  53.       X1              =   1320
  54.       X2              =   3840
  55.       Y1              =   220
  56.       Y2              =   220
  57.    End
  58.    Begin VB.Line Line2 
  59.       BorderColor     =   &H00FFFFFF&
  60.       X1              =   1340
  61.       X2              =   3860
  62.       Y1              =   240
  63.       Y2              =   240
  64.    End
  65.    Begin VB.Label Label1 
  66.       Caption         =   "Select a format:"
  67.       Height          =   255
  68.       Left            =   120
  69.       TabIndex        =   1
  70.       Top             =   120
  71.       Width           =   1215
  72.    End
  73. End
  74. Attribute VB_Name = "frmAddDate"
  75. Attribute VB_GlobalNameSpace = False
  76. Attribute VB_Creatable = False
  77. Attribute VB_PredeclaredId = True
  78. Attribute VB_Exposed = False
  79. Option Explicit
  80. Private Sub cmdDone_Click()
  81.     On Error Resume Next
  82.     'frmKB.topicChanged = True
  83.     'frmKB.SaveTopic
  84.     Unload Me
  85.     Err.Clear
  86. End Sub
  87. Private Sub cmdOk_Click()
  88.     On Error Resume Next
  89.     With frmKB.docWord
  90.         Select Case List1.Text
  91.         Case "1/2/03"
  92.             .SelRTF = Format$(Date, "d/m/yy")
  93.         Case "01/02/03"
  94.             .SelRTF = Format$(Date, "dd/mm/yy")
  95.         Case "01/02/2003"
  96.             .SelRTF = Format$(Date, "dd/mm/yyyy")
  97.         Case "1st February 2003"
  98.             .SelRTF = Format$(Date, "d") & GetSuffix & " " & Format$(Date, "mmmm yyyy")
  99.         Case "Monday"
  100.             .SelRTF = Format$(Date, "dddd")
  101.         Case "Monday 1st"
  102.             .SelRTF = Format$(Date, "dddd ") & Format$(Date, "d") & GetSuffix
  103.         Case "Monday 1st February"
  104.             .SelRTF = Format$(Date, "dddd ") & Format$(Date, "d") & GetSuffix & " " & Format$(Date, "mmmm")
  105.         Case "Monday 1st Febuary 2003"
  106.             .SelRTF = Format$(Date, "dddd ") & Format$(Date, "d") & GetSuffix & " " & Format$(Date, "mmmm yyyy")
  107.         Case "1:30"
  108.             .SelRTF = IIf(Hour(Time) > 12, Hour(Time) - 12, Hour(Time)) & ":" & Format$(Minute(Time), "00")
  109.         Case "13:30"
  110.             .SelRTF = Format$(Time, "hh:mm")
  111.         End Select
  112.     End With
  113.     Err.Clear
  114. End Sub
  115. Private Function GetSuffix() As String
  116.     On Error Resume Next
  117.     Dim Suffix As String
  118.     Select Case Day(Date)
  119.     Case "11", "12", "13"
  120.         Suffix = "th"
  121.     Case Else
  122.         Select Case Right$(Day(Date), 1)
  123.         Case "1"
  124.             Suffix = "st"
  125.         Case "2"
  126.             Suffix = "nd"
  127.         Case "3"
  128.             Suffix = "rd"
  129.         Case Else
  130.             Suffix = "th"
  131.         End Select
  132.     End Select
  133.     GetSuffix = Suffix
  134.     Err.Clear
  135. End Function
  136. Private Sub List1_DblClick()
  137.     On Error Resume Next
  138.     cmdOk_Click
  139.     Err.Clear
  140. End Sub
  141.